COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	   MARCDO: PROCEDURE OPTIONS (MAIN)
C00013 ENDMK
C⊗;
   MARCDO: PROCEDURE OPTIONS (MAIN);
     /*THIS PROGRAM READS A LIBRARY INSTRUCTION DECKLET, PRINTS
       IT OUT FROM THE STRUCTURE WHERE IT HAS BEEN STORED, AND
       PRINTS OUT THE RECORD DIRECTORY*/

     DECLARE
       1 DECKLET,

        2 CARDLET,   /*SET OF MARC SPECS*/
         3 TAG CHAR(3),
         3 SIZE CHAR(1),
         3 SUBF CHAR(16) VARYING,
         3 SUBF CHAR(16) VARYING,
       RECS FILE RECORD SEQUENTIAL, /*FILE CONTAINING DECKLETS*/
       (SYSIN, SYSPRINT) FILE STREAM,
       SUBSTR BUILTIN,
        INDEX BUILTIN,
∂      UNSPEC BUILTIN,
∂      (DELIM,FT,RT) CHAR(1),
       MARC FILE RECORD SEQUENTIAL;
∂  
     CALL DECKIT; /*ROUTINE TO READ IN AND PRINT OUT DECKLET*/
∂    CALL SPECSYM;/*ROUTINE TO ESTABLISH SPECIAL MARC SYMBOLS*/
∂    CALL MARCDIR; /*ROUTINE TO USE EXTRACTED RECORD DIRECTORY
∂                  TO PRINT FIELDS*/
     RETURN; /*RETURN CONTROL TO CMS*/

    DECKIT: PROCEDURE;
     /*THIS ROUTINE READS THE INFORMATION FROM THE DECKLET INTO
       A STRUCTURE AND THEN PRINTS IT OUT*/
     ON ENDFILE (SYSIN) EOF = '1'B;
     OPEN FILE (RECS) OUTPUT;

     DO WHILE (↑EOF);
        GET SKIP EDIT (DECKLET.CARDLET) (A(3),A(1),A(16));
       IF EOF THEN LEAVE;
        WRITE FILE (RECS) FROM (DECKLET); /*CREATE RECORD*/
     END;

     CLOSE FILE (RECS);

     EOF = '0'B; /*RESET END FLAG*/
     ON ENDFILE (RECS) EOF = '1'B;
     OPEN FILE (RECS) INPUT; /*OPEN FILE OF SPECS FOR INPUT*/
     DO WHILE (↑EOF);
        READ FILE (RECS) INTO (DECKLET.CARDLET);
       IF EOF THEN LEAVE;
       PUT SKIP EDIT (DECKLET.CARDLET) (A);
     END;

     CLOSE FILE (RECS);
     RETURN; /*RETURN TO MAIN PROGRAM*/
    END DECKIT;

     MARCDIR: PROCEDURE;
      /*THIS ROUTINE EXTRACTS AND PRINTS OUT THE MARC RECORD
        DIRECTORY AND SUBFIELDS INDICATED BY DECKLET*/

      DECLARE
        1 DECKLET,
         2 CARDLET,   /*SET OF MARC SPECS*/
          3 TAG CHAR(3),
          3 SIZE CHAR(1),
          3 SUBF CHAR(16) VARYING,
        (I,J,K,L) FIXED BIN (15),
        AREA CHAR(2000) VARYING,
        FIELD(50) CHAR(12),
∂       DELIM CHAR(1),
        PRINT BIT(1),
        LENGTH FIXED BIN(15),
        START FIXED BIN(15),
        DIR CHAR(500) VARYING; /*EXTRACTED DIRECTORY*/
      OPEN FILE (MARC) INPUT; /*OPEN THE FILE OF MARC RECS FOR INPUT*/
      EOF = '0'B;

∂D    PUT SKIP EDIT ('TAG','LENGTH','POSITION') (A(3),X(10),A(6),
∂D                    X(10),A(8));
∂D
∂     DO I = 1 TO 2;/*TRY THIS TWICE*/
∂       PUT SKIP(3) EDIT ('RECORD NUMBER ',I);
∂       PUT SKIP(2) EDIT ('TAG','SUBFIELD','CONTENTS') (A(3),X(10),A(8),
∂                         X(10),A(8));
∂       PUT SKIP;
        READ FILE (MARC) INTO (AREA);
        J = SUBSTR(AREA, 13, 5); /*GET STARTING POS. OF CONTROL
                                  FIELDS*/
∂       CHOP: /*DIVIDE INTO BLOCKS*/
          DO K = 1 TO (J-25)/12;

∂D        CALL PRINTFRM (SUBSTR(DIR,L,3),SUBSTR(DIR,L+3,4),
∂D                     SUBSTR(DIR,L+7,5));
          FIELD(K) = SUBSTR(DIR,L,12);/*START FILLING ARRAY
                     WITH FIELDS*/
          L = L + 12; /*SKIP TO NEXT 12 CHARACTERS*/
        END CHOP;
∂       CALL FLDPRT (FIELD,DECKLET,K,PRINT,J,AREA,DELIM);
       END;
       CLOSE FILE (MARC);
      RETURN;/*RETURN TO MAIN PROGRAM*/
      END MARCDIR;

∂      /*SUBROUTINE TO CREATE THE SPECIAL SYMBOLS MARKING 
∂      DELIMITER, FIELD TERMINATOR, AND RECORD TERMINATOR*/
∂
∂      SPECSYM: PROCEDURE;
∂        DCL
∂          UNSPEC BUILTIN,
∂          (TDEL,TFT,TRT) FIXED BIN(8);
∂ 
∂        /*SET UP CONSTANTS*/
∂        TDEL = 250;/*HEX FA*/
∂        TFT = 38;/HEX 26*/
∂        TRT = 55;/*HEX 37*/
∂  
∂        /*MOVE BINARY VALUES INTO CHAR STRING*/
∂        UNSPEC(DELIM) = TDEL;
∂        UNSPEC(RT) = TRT;
∂        UNSPEC(FT) = TFT;
∂  
∂        RETURN;
∂      END SPECSYM;
   
∂D       /*SUBROUTINE TO FORMAT DIRECTORY*/
∂D       PRINTFRM: PROCEDURE (TAG,LEN,POS);
∂D         DCL
∂D          TAG CHAR (3),
∂D          LEN CHAR (4),
∂D          POS CHAR (5);
∂D
∂D       PUT SKIP EDIT (TAG,LEN,POS)(A(3), X(11),A(4),X(13),A(5));
∂D       RETURN;
∂D       END PRINTFRM;
∂D
         /*SUBROUTINE TO PRINT OUT FIELDS LISTED IN DECKLET*/
∂        FLDPRT: PROCEDURE (FIELD,DECKLET,K,PRINT,J,AREA,DELIM);
           DECLARE
            1 DECKLET CONNECTED,
             2 CARDLET,   /*SET OF MARC SPECS*/
              3 TAG CHAR(3),
              3 SIZE CHAR(1),
              3 SUBF CHAR(16) VARYING,
            FIELD(*) CHAR(12),
            K FIXED BIN(15),
            J FIXED BIN(15),
             START FIXED BIN(15),
             LENGTH FIXED BIN(15),
             AREA CHAR(2000) VARYING,
∂            DELIM CHAR(1),/*SPECIAL CHARACTER*/
∂            DELIM1 FIXED BIN(15),/*POS. OF FIRST DELIM*/
∂            DELIM2 FIXED BIN(15),/*POS. OF 2ND DELIM*/
∂            CONTROLS CHAR(200) VARYING,/*CONTROL FIELD*/
∂            REMAINDER CHAR(200) VARYING,
∂            P FIXED BIN(15),
             N FIXED BIN(15);
                     
           EOF = '0'B;
           ON ENDFILE (RECS) EOF = '1'B;
           OPEN FILE (RECS) INPUT;


           DO WHILE (↑EOF);
            READ FILE (RECS) INTO (DECKLET.CARDLET);
            IF EOF THEN LEAVE;
                DO N = 1 TO (K-1);
                  IF (TAG = SUBSTR(FIELD(N),1,3)) THEN
∂                    DO P = 1 TO SIZE;
∂                      START = SUBSTR(FIELD(N),8,5) + J + 1;
∂                      LENGTH = SUBSTR(FIELD(N),4,4);              
∂                      CONTROLS = SUBSTR(AREA,START,LENGTH);/*DON'T FORGET ;*/
∂D                                (A(LENGTH));
∂                      DELIM1 = INDEX(CONTROLS,DELIM);
∂                        DO WHILE (INDEX(CONTROLS,DELIM)) ↑= 0;
∂                          REMAINDER = SUBSTR(CONTROLS,(DELIM1 + 1));
∂                          DELIM2 = INDEX(REMAINDER,DELIM);
∂                          IF SUBSTR(SUBF,P,1) = SUBSTR(CONTROLS,
∂                             (DELIM1 + 1),1) THEN
∂                             PUT SKIP EDIT (TAG,SUBF,SUBSTR(CONTROLS,
∂                                 (DELIM1 + 2),(DELIM2 - 1))) (A(3),X(13),
∂                                 A(1),X(14),A);
∂                          DELIM1 = DELIM2;
∂                         END;
∂                     END;
                 END;
∂D            END;
           END;
          CLOSE FILE (RECS);
        RETURN;
        END FLDPRT;
    END MARCDO;